home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / e / ProgSuite.lha / ProgSuite / Display.e < prev    next >
Encoding:
Text File  |  1996-09-09  |  6.7 KB  |  210 lines
  1. /* Display - ProgSuite V1.0 Display program */
  2.  
  3. MODULE 'intuition/intuition', 'intuition/screens', 'graphics/view'
  4. MODULE 'tools/ilbm', 'tools/ilbmdefs'
  5. MODULE 'amigalib/ports', 'dos/dos'
  6. MODULE 'exec/memory', 'exec/nodes', 'exec/ports'
  7.  
  8. MODULE '*Defs'
  9.  
  10. /* Screen size */
  11. CONST SIZEX = 640, SIZEY = 480
  12.  
  13. /* Variable to hold our own name (should be a constant...) */
  14. DEF progname: PTR TO CHAR
  15.  
  16. /* Communication variables */
  17. DEF displayport = NIL: PTR TO mp,
  18.     wakemsg = NIL: PTR TO portMessage, finishmsg = NIL: PTR TO portMessage,
  19.     recvmsg: PTR TO portMessage
  20.  
  21. /* Screen and window pointers */
  22. DEF progsuitescreen: PTR TO screen, panelwin: PTR TO window
  23.  
  24. /* variables for between-calls memory */
  25. DEF mx = 0, my = 0, prevsecs = 0
  26.  
  27. /* The main procedure */
  28.  
  29. PROC main () HANDLE
  30.  
  31.   progname := 'Display'
  32.   progsuitescreen := NIL ; panelwin := NIL
  33.   displayport := portCreate ('DisplayPort', progname)
  34.   wakemsg := messageCreate (displayport, progname)
  35.   wakemsg.msn := WAKEMSG  -> Our WakeUp message
  36.   finishmsg := messageCreate (displayport, progname)
  37.   finishmsg.msn := FINISHMSG  -> Our Finish message
  38.  
  39.   -> Display the instruments panel
  40.   initPanel ()
  41.  
  42.   -> Report our readyness to the master
  43.   WriteF ('\s: Sending WakeUp message (\d) to Master...\n', progname, wakemsg.msn)
  44.   IF FALSE = messageSend (wakemsg, 'MasterPort') THEN Raise (ERR_FINDPORT)
  45.  
  46.   -> Wait for messages, and act accordingly
  47.   displayLoop ()
  48.  
  49.   -> Finish off
  50.   finishPanel ()
  51.  
  52.   Raise (ERR_NONE)
  53. EXCEPT DO
  54.   IF displayport THEN portRemove (displayport)
  55.   IF wakemsg THEN Dispose (wakemsg)
  56.   IF finishmsg THEN Dispose (finishmsg)
  57.   IF (panelwin) THEN finishPanel ()
  58.   SELECT exception
  59.   CASE ERR_FINDSCREEN
  60.     WriteF ('\s: Can''t find ProgSuite Screen: This program should be started from Master!\n', progname)
  61.   CASE "WIN"
  62.     UnlockPubScreen (NIL, progsuitescreen)
  63.     WriteF ('\s: Can''t open window!\n', progname)
  64.   CASE "PORT"
  65.     WriteF ('\s: Can''t create messageport "DisplayPort"!\n', progname)
  66.   CASE ERR_FINDPORT
  67.     WriteF ('\s: Can''t find messageport "MasterPort"!', progname)
  68.   CASE "MEM"
  69.     WriteF ('\s: Can''t get memory!\n', progname)
  70.   ENDSELECT
  71. ENDPROC
  72.  
  73. /* procedures to display/remove the instruments panel */
  74.  
  75. PROC initPanel ()
  76. DEF ilbm, filename[30]:STRING, width, height, bmh:PTR TO bmhd, pi:PTR TO picinfo, bmptr = NIL
  77.  
  78.   StringF (filename, 'PROGDIR:Pictures/panel.iff')
  79.   IF ilbm := ilbm_New (filename, 0)
  80.     ilbm_LoadPicture (ilbm, [ILBML_GETBITMAP, {bmptr}, 0])
  81.  
  82.     -> get a pointer to the image's picture-info.
  83.     -> extract the bitmap header, and read the picture's size.
  84.     pi := ilbm_PictureInfo (ilbm)
  85.     bmh := pi.bmhd
  86.     width := bmh.w
  87.     height := bmh.h
  88.     -> the ilbm-handle is no longer needed, we can free it
  89.     ilbm_Dispose (ilbm)
  90.  
  91.     -> if a bitmap actually opened,
  92.     IF bmptr
  93.       -> Open our window on the common screen (horizontally centered, and as low as possible)
  94.       progsuitescreen := LockPubScreen ('ProgSuiteScreen')
  95.       panelwin := OpenW ((SIZEX - width) / 2, (SIZEY - height), width, height,
  96. ->                         IDCMP_MOUSEBUTTONS OR IDCMP_INTUITICKS,
  97.                          IDCMP_MOUSEBUTTONS,
  98.                          WFLG_BORDERLESS OR WFLG_RMBTRAP, NIL, NIL, NIL, NIL,
  99.                          [WA_PUBSCREEN, progsuitescreen, 0])
  100.       UnlockPubScreen (NIL, progsuitescreen)
  101.  
  102.       -> blit the picture into our window
  103.       -> blit into actual dimensions the OS gave us
  104.       -> (the window might be smaller than the picture)
  105.       BltBitMapRastPort (bmptr, 0, 0, 
  106.                          panelwin.rport, 0, 0,
  107.                          width, height, $c0);
  108.       -> now don't need the bitmap anymore
  109.       ilbm_FreeBitMap (bmptr)
  110.       bmptr := NIL
  111.     ENDIF
  112.   ELSE
  113.     WriteF ('\s: Could not open picture file "\s"!\n', progname, filename)
  114.   ENDIF
  115. ENDPROC
  116.  
  117. PROC finishPanel ()
  118.   CloseW (panelwin) ; panelwin := NIL
  119. ENDPROC
  120.  
  121. /* The main message loop */
  122.  
  123. PROC displayLoop ()
  124.   DEF portsig, winsig, usersig, signal, finish = FALSE
  125.   portsig := Shl (1, displayport.sigbit)
  126.   winsig := Shl (1, panelwin.userport.sigbit)
  127.   usersig := SIGBREAKF_CTRL_C  -> Give user a 'break' signal.
  128.                                -> Note: does not seem to work here...
  129.  
  130.   REPEAT
  131.     -> (for now, wait for the QUIT message)
  132.     signal := Wait (portsig OR winsig OR usersig)
  133.     IF signal AND usersig  -> The user wants to abort.
  134.       WriteF ('\s: Sending Finish message (\d) to Master...\n', progname, finishmsg.msn)
  135.       messageSend (finishmsg, 'MasterPort') ; finish := TRUE
  136.     ENDIF
  137.     IF signal AND winsig THEN handleWindowMessages ()
  138.     IF signal AND portsig THEN finish := handlePortMessages ()
  139.   UNTIL finish
  140.  
  141. ENDPROC
  142.  
  143. /* Procedure to handle incoming Exec messages */
  144.  
  145. PROC handlePortMessages ()
  146. DEF mesnum, finish = FALSE
  147.   WHILE recvmsg := GetMsg (displayport)
  148.     messageCheckOwn (recvmsg, displayport, progname)
  149.     mesnum := recvmsg.msn
  150.     SELECT mesnum
  151.       CASE QUITDISPLMSG
  152.         finish := TRUE
  153.     ENDSELECT
  154.     messageReply (recvmsg, displayport)
  155.   ENDWHILE
  156. ENDPROC finish
  157.  
  158. /* Procedure to handle Intuition messages */
  159.  
  160. PROC handleWindowMessages ()
  161. DEF recvimsg: PTR TO intuimessage, class, code
  162.   WHILE recvimsg := GetMsg (panelwin.userport)
  163.     class := recvimsg.class ; code := recvimsg.code
  164.     WriteF ('\s: IDCMP received: \d \d\n', progname, class, code)
  165.     SELECT class
  166.       CASE IDCMP_INTUITICKS
  167.         WriteF ('\s: IntuiTick message received\n', progname)
  168.         handleTimeTick (recvimsg.seconds, recvimsg.micros)
  169.       CASE IDCMP_MOUSEBUTTONS
  170.         WriteF ('\s: MouseButton message received: \d \d \d\n', progname, code, recvimsg.mousex, recvimsg.mousey)
  171.         handleMouseButtons (code, recvimsg.mousex, recvimsg.mousey)
  172.     ENDSELECT
  173.     messageReply (recvimsg, displayport)
  174.   ENDWHILE
  175. ENDPROC
  176.  
  177. PROC handleTimeTick (seconds, micros)
  178.   IF prevsecs = 0 THEN prevsecs := seconds
  179.   IF seconds > prevsecs
  180.     WriteF ('\s: One second passed\n', progname)
  181. ->    messageSend (tickmsg, 'MasterPort')
  182.     prevsecs := seconds
  183.   ENDIF
  184. ENDPROC
  185.  
  186. PROC handleMouseButtons (icode, imx, imy)
  187.   SELECT icode
  188.     CASE SELECTDOWN
  189.         WriteF ('\s: SelectDown message received: \d \d\n', progname, imx, imy)
  190.       mx := imx ; my := imy
  191.     CASE SELECTUP
  192.         WriteF ('\s: SelectUp message received: \d \d\n', progname, imx, imy)
  193.       IF mx = imx AND my = imy THEN checkButton (mx, my)
  194.     CASE MENUDOWN
  195.         WriteF ('\s: MenuDown message received: \d \d\n', progname, imx, imy)
  196.       mx := imx ; my := imy
  197.     CASE MENUUP
  198.         WriteF ('\s: MenuUp message received: \d \d\n', progname, imx, imy)
  199.       IF mx = imx AND my = imy THEN doSubwin (mx, my)
  200.   ENDSELECT
  201. ENDPROC
  202.  
  203. PROC doSubwin (mx, my)
  204.   WriteF ('\s: Subwindow selected...\n', progname)
  205. ENDPROC
  206.  
  207. PROC checkButton (mx, my)
  208.   WriteF ('\s: Button selected...\n', progname)
  209. ENDPROC
  210.